unit io_imagecapture_imgUtils;

{
  Small procedural utilities for image editing and analysis.
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, math;

type
  TColorIntegerArray = array of Integer;

procedure SingleColorImg(AImgInput: Graphics.TBitmap; AImgOutput: Graphics.TBitmap);
procedure SingleColorImgEX(AImgInput: Graphics.TBitmap; AImgOutput: Graphics.TBitmap; AColor: TColor);
procedure ExtractBitmapRect(AImgInput: Graphics.TBitmap; AImgOutput: Graphics.TBitmap; ARect: TRect);
function AvgColorInRect (AImgInput: Graphics.TBitmap; ARect: TRect): TColor;
function CompareColors (AColor: TColor; ACompareTo: TColor; AThreshold: integer=20): boolean;
function CompareColorsValue (AColor: TColor; ACompareTo: TColor): integer;
function CompareColorsEx(AColor: TColor; ACompareTo: array of TColor; AThreshold: integer=-1): integer;
procedure CountColorPixel(AImgInput: Graphics.TBitmap; ARect: TRect; AColors: array of TColor; var AOutput: TColorIntegerArray);
procedure CountColorPixelEx(AImgInput: Graphics.TBitmap; ARect: TRect; AColors: array of TColor; AThreshold: integer; var AOutput: TColorIntegerArray);

implementation

procedure SingleColorImg(AImgInput: Graphics.TBitmap; AImgOutput: Graphics.TBitmap);
var
  x, y: integer;
begin
  for y := 0 to AImgInput.Height do
  begin
    for x := 0 to AImgInput.Width do
    begin
      if (AImgInput.Canvas.Pixels[x,y] = clred) or (AImgInput.Canvas.Pixels[x,y] = clblack) then
      begin
        AImgOutput.Canvas.Pixels[x,y] := clblack;
      end else
      begin
        AImgOutput.Canvas.Pixels[x,y] := clwhite;
      end;
    end;
  end;
end;

procedure SingleColorImgEX(AImgInput: Graphics.TBitmap;
  AImgOutput: Graphics.TBitmap; AColor: TColor);
var
  x, y: integer;
begin
  for y := 0 to AImgInput.Height do
  begin
    for x := 0 to AImgInput.Width do
    begin
      if (AImgInput.Canvas.Pixels[x,y] = AColor)then
      begin
        AImgOutput.Canvas.Pixels[x,y] := clblack;
      end else
      begin
        AImgOutput.Canvas.Pixels[x,y] := clwhite;
      end;
    end;
  end;
end;

procedure ExtractBitmapRect(AImgInput: Graphics.TBitmap; AImgOutput: Graphics.TBitmap; ARect: TRect);
var
  PartImg: Graphics.TBitmap;
begin
  PartImg := Graphics.TBitmap.Create;
  try
    PartImg.SetSize(ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
    PartImg.Canvas.Draw(-ARect.Left,-ARect.Top,AImgInput);
    AImgOutput.Assign(PartImg);
  finally
    PartImg.Free;
  end;
end;

function AvgColorInRect(AImgInput: Graphics.TBitmap; ARect: TRect): TColor;
var
  x, y: integer;
  r,g,b: int64;
  h,w: int64;
begin
  h := max(abs(ARect.Bottom-ARect.Top),1);
  w := max(abs(ARect.Right-ARect.Left),1);
  r  := 0; g  := 0; b  := 0;
  for y := min(ARect.Top,ARect.Bottom) to max(ARect.Top,ARect.Bottom) do
  begin
    for x := min(ARect.Left,ARect.Right) to max(ARect.Left,ARect.Right) do
    begin
      r := r+ red  (AImgInput.Canvas.Pixels[x,y]);
      g := g+ green(AImgInput.Canvas.Pixels[x,y]);
      b := b+ blue (AImgInput.Canvas.Pixels[x,y]);
    end;
  end;
  r := EnsureRange(r div (h*w),0,255);
  g := EnsureRange(g div (h*w),0,255);
  b := EnsureRange(b div (h*w),0,255);
  result := RGBToColor(r, g, b);
end;

function CompareColors(AColor: TColor; ACompareTo: TColor; AThreshold: integer): boolean;
begin
  result := InRange(blue(AColor), blue(ACompareTo)- AThreshold, blue(ACompareTo)+AThreshold)
        and InRange(red(AColor),  red(ACompareTo)-  AThreshold,  red(ACompareTo)+AThreshold)
        and InRange(green(AColor),green(ACompareTo)-AThreshold,green(ACompareTo)+AThreshold);
end;

function CompareColorsValue(AColor: TColor; ACompareTo: TColor): integer;
var
  r,g,b: extended;
begin
  r := abs(red  (AColor)-   red(ACompareTo));
  g := abs(green(AColor)- green(ACompareTo));
  b := abs(blue (AColor)- blue (ACompareTo));
  result := round(r+g+b);
end;

function CompareColorsEx(AColor: TColor; ACompareTo: array of TColor;
  AThreshold: integer): integer;
var
  i:integer;
  minValue,Value: integer;
begin
  result := -1;
  minValue := MAXINT;
  for i:=0 to high(ACompareTo) do
  begin
    Value := CompareColorsValue(AColor,ACompareTo[i]);
    if Value < MinValue then
    begin
      MinValue := value;
      result := i;
    end;
  end;
  if MinValue > AThreshold then
  begin
    if AThreshold <> -1 then
    begin
      result := -1;
    end;
  end;
end;

procedure CountColorPixel(AImgInput: Graphics.TBitmap; ARect: TRect;
  AColors: array of TColor; var AOutput: TColorIntegerArray);
begin
  CountColorPixelEx(AImgInput,ARect,AColors,1,AOutput);
end;

procedure CountColorPixelEx(AImgInput: Graphics.TBitmap; ARect: TRect;
  AColors: array of TColor; AThreshold: integer; var AOutput: TColorIntegerArray
  );
var
  x, y, i: integer;
begin
  setlength(AOutput,length(AColors));
  for i := low(AColors) to high(AColors) do
  begin
    AOutput[i] := 0;
  end;
  for y := ARect.Top to ARect.Bottom do
  begin
    for x := ARect.Left to ARect.Right do
    begin
      AOutput[i] := 0;
      for i := low(AColors) to high(AColors) do
      begin
        if CompareColors(AImgInput.Canvas.Pixels[x,y],AColors[i],AThreshold) then
        begin
          inc(AOutput[i]);
        end;
      end;
    end;
  end;
end;

function ColorsInRect(AColor: array of TColor; AImgInput: Graphics.TBitmap;
  ARect: TRect): Cardinal;
var
  x, y, i: integer;
begin
  result := 0;
  for y := ARect.Top to ARect.Bottom do
  begin
    for x := ARect.Left to ARect.Right do
    begin
      for i := 0 to high(AColor) do
      begin
        if (AImgInput.Canvas.Pixels[x,y] = AColor[i]) then
        begin
          inc(result);
        end;
      end;
    end;
  end;
end;

end.

